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MODULE COBSSET_SWITCH( 
ve = *1-004" ! file: COBSETSWI.832 EDIT:LB1004 


BEGIN 


' 
. 
PEPSI S TTI TTT TTT iti iii itiiiiiiiiiiigg) 


+* COPYRIGHT (c) ere. 1980, 1982, 1984 B 
1 Hd they QUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. 
: se AL L RIGHTS RESERVED. 

;@ 
1 :* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
1 t@ ONLY IN ACCORDANCE WITH THE rene OF SUCH at AND WITH THE 
1 ie anche lon OF THE ABOVE COPYRIGHT NOTICE. THIS sort ARE OR ANY gee 
1 t* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO AN 
; ~ vie PERSON. NO TITLE TO AND OWNERSHIP OF THE SOF TUARE IS HEREBY 
1 


:® THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
:* sppohatT ihe ROT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


'® DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
:# SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


‘e 
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i FACILITY: COBOL SUPPORT 
i ABSTRACT 


MEMO OBNANES UN HOO OVNOAVE WH (OOONOUES Ww 


Sets external switches. 


i 

1 

{ 

] 

‘ 

4 

' 

: ENVIRONMENT: Vax-11 User Mode 
AUTHOR: MLJ , CREATION DATE: 30-Oct-1979 
' 

' 

a 

1 

‘ 

A 

1 

‘ 

‘ 


9 
40 
41 ' 
$5 ! MODIFIED BY: 
44 ! 1-001 - Original Pm coaswite -B32 1-005. MLJ pocOgtat972. 
45 1- = pignal das SETEXTFAL if S$CRELOG fails. ug-81 
4 1- - Added EDIT Bhrase sec Se crea os X. “pid audit trail. 
4 : Also updated sagt’ ght LB 1 
48 ! 1-004 = Use logical LNMSC_N MLEMeTH tebhond ° hard-coded 64. 
49 LGB 31-0CT-83 
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SWITCHES 


SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 


LINKAGES 
LINKAGE 

L = JSB : GLOBAL(PTR=2, CNT=3, D1G=4); 
TABLE OF CONTENTS: 


FORWARD nov Ie 
GET. 


6 DIGIT: L; P 
8 INCLUDE riLes } 
71 REQUIRE *RILIN: RTLPSECT* 3 ! Macros to declare psects P 
y LIBRARY *RTLSTARLE'; ; 
74 ! S 
75 ' MACROS P 
7 ! C 
f : NONE A 
8 i EQUATED SYMBOLS T 
80 : 2 

1 EXTERNAL LITERAL T 
§ COBS_SETEXTFAI; ! SET external switch failed 4 

' 
5 


PSECT DECLARATIONS: 


Be Se Se Se Se Se Ge Se Ge Ge Ge Se Ge Ge Se Ge Ge Se Ge Se Se Se Se Se Se Se Se Se Ge Se Se ee Se Se Se Sees 
VO 
oO 


a me Bk a a a tt at Nt WS 8 
oe = 


DECLARE _PSECTS (COB) ; ! Declare psects for COBS facility 


rime WeseerHs QO:45:15  YMGET SLSR Mio, Pane 5} 


‘ ; } pn. ROUTINE eT Ai ct ain gia 

; : 184 | i++ FUNCTIONAL DESCRIPTION 

; 186 1! 

: 5 ; i This routine sets and clears external switches. 

; 189 1: 

3 8 : : ! : FORMAL PARAMETERS: 

.% 1 1 / SET_MASK - Bit mask of switches to be set or cleared. 
: 101 1 1! Bi fs ge correspond, ° external 

: : ¢ 132 : } switches numbered {through 

; 1 1 ii DO_SET - If true, the indicated switches are set. 

; 198 199 : : Otherwise, they are cleared. 

3 107 138 { IMPLICIT INPUTS: 

; 199 OT ! Logical name table 

; 111 88 | IMPLICIT OUTPUTS: 

: 8 New definition for logical name COBSSWITCHES. 

; 115 0 { ROUTINE VALUE: 

; 9 88 1! NONE 

; 6118 19 1! 

: 133 : : : COMPLETION CODES: 

; 121 9 18 NONE 

; § 15 | SIDE EFFECTS: 

; 5 13 ; NONE 

en Sie 

> 129 1 2. BEGIN 

3 1 § LOCAL 

s 131 FFER: vector NMSC_NAMLENGTH, byte). ! Returned 4 eguivelence string 
3; 1 § 4 BUF DESC: CTOR ntl. escriptor for 

3 4 3 NAMDESC: VECTOR Descriptor for Colca name 
a | $ LENGTH: WORD, ' Length of equivalence string 
3; 135 a. ' Local bit mask of switches 
ce w 3 STA ! System service status 

of GLOBAL jek 

>| 0 anes, D1G=4; 

: 1% ; 

+ 141 

: 146 BUFDESCED = LNMSC_NAMLENGTH; ' Set up descriptors 

; re 5 BurDESctT = BUFFER; nied 

> = Py . eee 

: 145 NAMDESC a = UPLIT(*COBSSWITCHES'); i ek: 


fOBBSET _SuLTCH ibesen-1964 0:15:15 yaucdt OLing52 ye.0-74g, 


MASK = 0; ! Initialize the mask 
IF STRNLOG( i Translate COBSSWITCHES 
THENECONAM=NAMDESC, RSLLEN=LENGTH, RSLBUF =BUF DESC) 

Begin BUFFER; ' Set lobal regi 

CNT = .LENGTH; ype amen Sy, aria 


vw 
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1 00 
EGIN LOCAL VAL; 
i Skip Leading non-digits. 


WHILE (IF .CNT GTR 0 THEN NOT GET_DIGIT() ELSE LEAVE LOOP) DO 0; 


Remember first digit. 


VAL = .DIG; 

: Scan over digits to next non-digit, computing value in VAL. 

WHILE (IF .CNT GTR O THEN GET_DIGIT() ELSE 0) DO VAL = .VAL * 10 + .DIG; 
} Put value into mask, if it is in range 1 to 16. 


iF (VAL = .VAL = 1) LEQU 15 THEN MASK<.VAL,1> = 1; 


re 
-om2 


DONAOVLS WIN "OO OONOUS WOO 


wr 


END; 
END; ! of Labelled block LOOP 
! The entire equivalence string for COBSSWITCHES has now been processed, 
! and MASK contains the bit mask of switches that were set. Modify it 


: according to the routine parameters. 


if .00_SET 
THEN MASK = .MASK OR .SET_MASK 
ELSE MASK = .MASK AND NOT~.SET_MASK; 


SNS PA AAPA AAAA MMMM BBP EP EE 
PUN SSSHUSARGRS oS 
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: Convert the bit mask to a new equivalence string. 

PTR = BUFFER; 

(.PTR)<O,8> = 2C° °; ! Use a leading space to be sure the 
= .PTR ¢ 1; ! string isn't of zero length. 

INCR 1 FROM 0 fo 15 00 
IF .MASK<,1,1> 

BEGIN LOCAL VAL; 


i The switch is set. Put the decimal ASCII representation into 
! the buffer. Since we know the value is 1 through 16, 


me ee ee mee ee em ee et ed ee a ed ad ed ed od = ed od = = SS 2 8 SD — 
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Kk 3 
SSET_SWITCH 16-Sep-1 215: AX-11 Bliss-32 V4.0-74 
eet 127808-}382 90:13:59 COBRTL. aeicdssttgur bS2:1 
° i] - 
: 4 3 : a@ special-purpose conversion can be done. 
3 4 38 4 VAL = .] + 1; 
; 4 IF .VAL GEQU 10 
3 $8 THEN 
; BEGIN 
: 210 (.PTR)<0,8> = %C'1'; 
: 211 PTR = .PTR + 1: 
: \¢ VAL = .VAL = 10; 
; 21 5 4 ND; 
: 214 6 4 (.PTR)<O,8> = .VAL # %C'0'; 
: 215 4 PTR = .PTR + 1; 
3 16 § ha (.PTR)<0,8> = &C° '; 
: 21 4 PTR = .PTR + 1; 
; 218 \9 END; 
: 219 1 END; 
3 i 
; ¢ 8 \ } The string has now been constructed. Redefine the logical name. 
3 226 1 BUF DESCEO} = .PTR = BUFFER; 
3: 225 1 BUFDESCL1] = BUFFER; 
3; 226 P 18 IF NOT (STATUS = $CRELOG( 
; 7 P 031 TBLFLG=2, ' Process table 
; 228 P 0320 LOGNAM=NAMDESC 
; & 1 THENE CE NAM=BUFDESCS) 
3 i 0 § SIGNAL (COB$_SETEXTFAI, 0, .STATUS); 
; 5 1 
3; 234 b356 1 END; 
-TITLE COBSSET_SWITCH 
“IDENT \1-004\ 
-PSECT _COBSCODE.NOWRT, SHR, PIC,2 
53 45 468 43 54 49 57 53 26 42 4F 43 00000 P.AAA: .ASCII \COBSSWITCHES\ 
-EXTRN COBS_SETEXTFAI, SYSS$TRNLOG 
“EXTRN SYSSCRELOG 
OFFe 00000 .ENTRY C $séT SWITCH, Save R2,R3.R4.R5.R6,R7_R8,- 
R9,R10,R11 
5E FEEC ce 9 0 02 MOV - Pg(sB) SP 
oc AE FF 4 68F «OOM MOVZBL #255, BUFDESC 
10 AE 14 AE 3 9 MOV BUFFER, BUFDESC+4 
4 AE 0c p MOVL 2, NAMDESC 
8 AE pc oA . 1 MOVAB P.AAA, NAMDESC+4 
6 p 1A CLRL MASK 
—E 7C 0001C CLRO = = (SP) 
7E D4 0001 CLRL = (SP) 
18 AE OOF PUSHAB BUFDESC 
10 AE 9F PUSHAB LENGTH 
18 AE OF PUSHAB NAMDESC 
000000006 00 06 FB CALLS #6, SYSSTRNLOG 


3 
coRsset _sviten iBrSep-1984 0:15:15  yaytt BLieg=S2 v4.0-74g, age 


50 €9 BLBC =—«_«RO,,_ 4S : 
16 AE SE MOVAB BUFFER, PTR + 0245 
; MOVZWL LENGTH, CNT + 0246 
d A 1$: TSTL CNT : 0256 
A | C BLEG )40= ss 4$ : 
00 Ov : BSBW  GET_DIGIT : 
ES E 4 BLBC ~=E._—«aR0,, "1 : 
5 4 0 4 MOVL 16, VAL + 0260 
D 47 2: TSTL NT + 0264 
1 } 49 BLEG $ ; 
0000v 48 BSBWStié«GG T_pyGiT : 
A 0 € BLBC_ RO, ~3$ : 
50 5 A ¢ MULL3 #16, VAL, RO ; 
ge 0 4 4 3 ADDL BIG. RO, VAL ; 
iS o 5B 3$: DECL VAL + 0268 
OF D1 00050 CMPL VAL, #15 ; 
08 1A 0 6 BGTRU 1$ : 
D4 56 Fe 6 BBSS VAL, MASK, 1$ ; 
D2 11 00 BRB 1$ : 0251 
06 08 ac €9 006 4$: BLBC_ 00-SET, 5$ ; 078 
a 04 at ce 006 Bist2 SET_MASK, MASK + 0279 
56 04 AC CA 00072 58: BICL2 SET_MASK, MASK ; 0280 
32 14 AE 3 0076 6$: MOVAB BUFFER PTR + 0285 
8 90 0007A MOVB #32, (PTR)+ + 0286 
1 04 0070 CLRL : 0288 
16 56 1 FI OO7F 7$: BBC } MASK, 9$ + 0290 
50 01 «Al : 0083 MOVAB 1(R1), VAL : 0298 
0A 50 01 0008 CMPL AL, #10 : 0299 
06 1F OOOBA BLSSU : 
82 19 OBC MOVB #49, (PTR)+ : 0302 
5 A O8F SUBL2 #10, VAL + 0304 
82 50 0 092 8$: ADDBS #48, VAL, (PTR)+ : 0306 
B2 0 9 0 MOVE #32. (PTR)+ 3 9308 
E2 51 F £3 00099 9$ AOBLEQ ; F 288 
30 14 AE 9 090 MOV BUFFER RO + 0316 
OC AE 5 5 § Al SUBL3 RO, PTR, BUFDESC F 
10 AE 14 AE SE 0006 MOVAB BUFFER, BUFDESC+4 : 0317 
7E D4 OOOAB CLRL = (SP) : 0321 
10 AE OF PUSHAB BUFDESC ; 
0c AE OF PUSHAB NAMDESC ; 
DD 0008 PUSHL # ; 
000000006 00 4 F B CALLS @# SYS$CRELOG : 
9 E BC BLBS STATUS, 10 : 
| DD O00BF PUSHL STATUS + 0323 
E D4 000C CLRL.  =(SP F 
000000006 8F DD 000C¢ PUSHL #COBS SETEXTFAL F 
000000006 3 FB ¢ CALLS #3, LTB SIGNAL : 
1 20 09 108: OVE wis R > 0326 


3; Routine Size: 212 bytes, Routine Base: _COBSCODE + 000C 


a 3 
= ais ambi 1e-$ep-1984 12:10:57 — ECdantussReScosse Sul 682-1 tanh 


; J] ROUTINE GET DIGIT: L= 

i 938 ; | j++ FUNCTIONAL DESCRIPTION 

: 240 11: 

> 241 § 1 ! Get next character from string, returning: 

3 tg 1! PTR advanced to next character 

; 24 4 1! "NT decremented 

> 244 . 3% vIG containing the character less %C'0' 

; eg | } } Value true if and only if the character was a digit 
; 26 1 i 

; 48 4 1 ! FORMAL PARAMETERS: 

: $38 ay yi 

; 2 4g { IMPLICIT INPUTS: 

if wile = 

: 255 1 | IMPLICIT OUTPUTS: 

: 256 47 1! 

Pp 4 oe 

> 259 350 1 | ROUTINE VALUE: 

; 4 8 23 } : COMPLETION CODES: 

: 36g 0358 ii wae 

; 64 0339 i SIDE EFFECTS: 

3 266 0337 1! NONE 

: 267 0 28 1! 

3; 268 359 1 I= 

: $3 360 + BEGIN 

; rt 36 EXTERNAL REGISTER 

$ Le: 307 PTR, CNT, DIG; 

: 7 LOCAL 

3 re 366 VAL; 

; 76 4 VAL = 0; ! Assume false value 
3 277 68 DIG = .(.PTR)<0,8>; ! Fetch character 
3; 278 ‘") PTR = .PTR + 1; ! Advance pointer 
3: 279 ? CNT = .CNT = 1; } pecrenen count 
3 280 7 DIG = .DIG = 2C'0'; i Bias character 

: 281 a IF .DIG LEQU 9 THEN VAL = .VAL + 1; ' Set true value if need be 
3 Hd a eval ' Return the value 


50 D4 00000 GET_DIGIT: 
54 9A movie. \<PTRD+, DIG : O68 
8 d7 $6008 DECL CNT ~ : i 


-- 


N 
COBSSET_SWITCH 16-Sep-1984 Ax-1 V4.0-74 Page 8 
1-008 1228 ep-19 99:10i5? = Feber te saedcoasy tur ase. 1 9 a) 
4 7 SUBL2 #48, p G 3 0371 
3 ¢ Of A CMPL DIG, & 8 o355 
& D BGTRU : 
06 F INCL VAL : 
11 18: RSB 3 0374 
; Routine Size: 18 bytes, Routine Base: _COBSCODE + 00E0 
; 284 0375 0 END ELUDOM 
iy 
«EXTRN LIBSSIGNAL Q 
; PSECT SUMMARY ; 
; Name Bytes Attributes 0 
: _COBSCODE 242 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) é 
Q 
; Library Statistics 0 
Beene eee ee ee Symbols -------- Pages Processing 0 
: File Total Loaded Percent Mapped Time ¢ 
3 _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 5 0 581 00:00.8 9 
; COMMAND QUALIFIERS 
HY BLISS/CHECK=CFIELD, INITIAL OPTIMIZE) /MOTRACE/L IS@L ISS: COBSETSU1/08J=08J8: COBSETSUI MSRC$: COBSETSWI /UPDATE=(ENH$: COBSE TSW! 
Size: 230 e + 12 data bytes 
Run Time: 8: 4.9 
Elapsed Time: 1.5 


Lines/CPU Min: 

povenes/<Ay-mias ati 
canory Oe sed: 5 pages 

Compilation Complete 
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